home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 11 / Mac Magazin and MacEasy Magazine CD - Issue 11.iso / Sharewarebibliothek / Entwickler / WASTE 1.1b1 Distribution / Demo Source / Segments.p < prev    next >
Text File  |  1995-06-01  |  4KB  |  121 lines
  1. unit Segments;
  2.  
  3. { Routines for unloading code segments easily }
  4. { Copyright © 1994 Marco Piovanelli }
  5.  
  6. { *** RATIONALE: *** }
  7. { Many applications are segmented so that some code segments are persistent }
  8. { (automatically preloaded and locked when the application is launched, }
  9. { never unloaded) and the others are non-persistent (loaded on demand, }
  10. { usually unloadable from the main event loop). }
  11. { Unfortunately, you must explicitly call _UnloadSeg to have a segment unloaded }
  12. { (i.e., unlocked and made purgeable) and you have to pass _UnloadSeg a pointer }
  13. { to [the jump table entry for] a routine in the segment to unload. }
  14. { This may not be always handy.  But wait!  The UnloadNonPersistentSegments }
  15. { routine automatically finds and unloads all non-persistent segments. }
  16. { It does this by listing all CODE resources whose locked attribute is clear }
  17. { (the resource attribute, _not_ the handle state) and whose purgeable attribute }
  18. { is set.  It then calculates the address of the jump table entry for the first routine }
  19. { in the segment and calls _UnloadSeg on the address. }
  20.  
  21. { *** THIS CODE ASSUMES THAT: *** }
  22. { The application has a traditional, IM II-style jump table (not a far-code JT) }
  23. { The current resource file is the application file }
  24. { The A5 register is set up correctly }
  25. { UnloadNonPersistentSegments is called from a persistent segment }
  26.  
  27. interface
  28.  
  29.     procedure UnloadNonPersistentSegments;
  30.  
  31. implementation
  32.     uses
  33.         ConditionalMacros, Types, Resources, SegLoad, LowMem;
  34.  
  35. {$IFC NOT UNDEFINED THINK_PASCAL}
  36.  
  37.     const
  38.  
  39.         kTypeCodeSegment = 'CODE';        { application code segment resource type }
  40.  
  41.     type
  42.  
  43.         CodeSegment = record
  44.                 firstEntryOffset: Integer;        { offset of the first routine's entry from the beginning of the Jump Table }
  45.                 nEntries: Integer;                    { number of entries for this segment }
  46. { actual code follows... }
  47.             end;
  48.         CodeSegmentPtr = ^CodeSegment;
  49.         CodeSegmentHandle = ^CodeSegmentPtr;
  50.  
  51.     function GetA5: LongInt;
  52.     inline
  53.         $2E8D;                    { movea.l a5, (sp) }
  54.  
  55.     function GetSegmentByIndex (segmentIndex: Integer): Handle;
  56.         var
  57.             saveResLoad: Boolean;
  58.     begin
  59.  
  60. { temporarily disable loading of resources }
  61.         saveResLoad := Boolean(LMGetResLoad);
  62.         SetResLoad(false);
  63.  
  64. { get a (possibly empty) handle to the specified segment }
  65.         GetSegmentByIndex := Get1IndResource(kTypeCodeSegment, segmentIndex);
  66.  
  67. { restore the original ResLoad flag }
  68.         SetResLoad(saveResLoad);
  69.  
  70.     end;  { GetSegmentByIndex }
  71.  
  72.     procedure UnloadSegmentHandle (hSegment: Handle);
  73.     begin
  74.  
  75. { do nothing if the segment handle is null or empty }
  76.         if (hSegment <> nil) then
  77.             if (hSegment^ <> nil) then
  78.  
  79. { calculate the address of the first routine entry in the segment }
  80. { and call _UnloadSeg on the calculated address }
  81.                 UnloadSeg(ProcPtr(GetA5 + LMGetCurJTOffset + CodeSegmentHandle(hSegment)^^.firstEntryOffset + 2));
  82.  
  83.     end;  { UnloadSegmentHandle }
  84.  
  85.     procedure UnloadNonPersistentSegments;
  86.         var
  87.             segmentIndex: Integer;
  88.             segmentAttributes: Integer;
  89.             hSegment: Handle;
  90.     begin
  91.  
  92. { loop through all code segments }
  93.         for segmentIndex := Count1Resources(kTypeCodeSegment) downto 1 do
  94.             begin
  95.  
  96. { get segment handle }
  97.                 hSegment := GetSegmentByIndex(segmentIndex);
  98.  
  99. { get resource attributes of the segment }
  100.                 segmentAttributes := GetResAttrs(hSegment);
  101.  
  102. { do nothing if a resource error occurred }
  103.                 if (ResError <> noErr) then
  104.                     Cycle;
  105.  
  106. { check whether 'purgeable' is on and 'locked' is off }
  107.                 if (BAND(segmentAttributes, resPurgeable + resLocked) = resPurgeable) then
  108.                     UnloadSegmentHandle(hSegment);
  109.  
  110.             end;  { for }
  111.     end;  { UnloadNonPersistentSegments }
  112.  
  113. {$ELSEC}
  114.  
  115.     procedure UnloadNonPersistentSegments;
  116.     begin
  117.     end;  { UnloadNonPersistentSegments }
  118.  
  119. {$ENDC}
  120.  
  121. end.